home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
tvgraph.exe
/
TVGDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-29
|
17KB
|
637 lines
{************************************************}
{ }
{ Turbo Pascal 6.0 }
{ Turbo Vision Demo }
{ Copyright (c) 1990 by Borland International }
{ }
{************************************************}
program TVDemo;
{$X+,S-}
{$M 16384,8192,655360}
{ Turbo Vision demo program. This program uses many of the Turbo
Vision standard and demo units, including:
StdDlg - Open file browser, change directory tree.
MsgBox - Simple dialog to display messages.
ColorSel - Color customization.
Gadgets - Shows system time and available heap space.
AsciiTab - ASCII table.
Calendar - View a month at a time
Calc - Desktop calculator.
FViewer - Scroll through text files.
HelpFile - Context sensitive help.
MouseDlg - Mouse options dialog.
Puzzle - Simple brain puzzle.
And of course this program includes many standard Turbo Vision
objects and behaviors (menubar, desktop, status line, dialog boxes,
mouse support, window resize/move/tile/cascade).
}
uses
Dos, TvGraph, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg, MsgBox, App,
DemoCmds, {Gadgets, }Puzzle, Calendar, AsciiTab, Calc, FViewer, HelpFile,
DemoHelp, ColorSel, MouseDlg, Styx, Crt;
type
{ TTVDemo }
PTVDemo = ^TTVDemo;
TTVDemo = object(TApplication)
{ Clock: PClockView;
Heap: PHeapView;}
constructor Init;
procedure FileOpen(WildCard: PathStr);
procedure GetEvent(var Event: TEvent); virtual;
function GetPalette: PPalette; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Idle; virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
procedure LoadDesktop(var S: TStream);
procedure OutOfMemory; virtual;
procedure StoreDesktop(var S: TStream);
procedure ViewFile(FileName: PathStr);
end;
{ CalcHelpName }
function CalcHelpName: PathStr;
var
EXEName: PathStr;
Dir: DirStr;
Name: NameStr;
Ext: ExtStr;
begin
if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
else EXEName := FSearch('TVDEMO.EXE', GetEnv('PATH'));
FSplit(EXEName, Dir, Name, Ext);
if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
CalcHelpName := FSearch('DEMOHELP.HLP', Dir);
end;
{ TTVDemo }
constructor TTVDemo.Init;
var
R: TRect;
I: Integer;
FileName: PathStr;
begin
TApplication.Init;
ShadowSize.X:=0;
ShadowSize.Y:=0;
RegisterObjects;
RegisterViews;
RegisterMenus;
RegisterDialogs;
RegisterApp;
RegisterHelpFile;
RegisterPuzzle;
RegisterCalendar;
RegisterAsciiTab;
RegisterCalc;
RegisterFViewer;
RegisterStyx;
{ GetExtent(R);
R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
Clock := New(PClockView, Init(R));
Insert(Clock);
GetExtent(R);
Dec(R.B.X);
R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
Heap := New(PHeapView, Init(R));
Insert(Heap); }
for I := 1 to ParamCount do
begin
FileName := ParamStr(I);
if FileName[Length(FileName)] = '\' then
FileName := FileName + '*.*';
if (Pos('?', FileName) = 0) and (Pos('*', FileName) = 0) then
ViewFile(FExpand(FileName))
else FileOpen(FileName);
end;
end;
procedure TTVDemo.FileOpen(WildCard: PathStr);
var
D: PFileDialog;
FileName: PathStr;
begin
D := New(PFileDialog, Init(WildCard, 'Open a File',
'~N~ame', fdOpenButton + fdHelpButton, 100));
D^.HelpCtx := hcFOFileOpenDBox;
if ValidView(D) <> nil then
begin
if Desktop^.ExecView(D) <> cmCancel then
begin
D^.GetFileName(FileName);
ViewFile(FileName);
end;
Dispose(D, Done);
end;
end;
procedure TTVDemo.GetEvent(var Event: TEvent);
var
W: PWindow;
HFile: PHelpFile;
HelpStrm: PDosStream;
const
HelpInUse: Boolean = False;
begin
TApplication.GetEvent(Event);
case Event.What of
evCommand:
if (Event.Command = cmHelp) and not HelpInUse then
begin
HelpInUse := True;
HelpStrm := New(PDosStream, Init(CalcHelpName, stOpenRead));
HFile := New(PHelpFile, Init(HelpStrm));
if HelpStrm^.Status <> stOk then
begin
MessageBox('Could not open help file.', nil, mfError + mfOkButton);
Dispose(HFile, Done);
end
else
begin
W := New(PHelpWindow,Init(HFile, GetHelpCtx));
if ValidView(W) <> nil then
begin
ExecView(W);
Dispose(W, Done);
end;
ClearEvent(Event);
end;
HelpInUse := False;
end;
evMouseDown:
if Event.Buttons <> 1 then Event.What := evNothing;
end;
end;
function TTVDemo.GetPalette: PPalette;
const
CNewColor = CColor + CHelpColor;
CNewBlackWhite = CBlackWhite + CHelpBlackWhite;
CNewMonochrome = CMonochrome + CHelpMonochrome;
P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
(CNewColor, CNewBlackWhite, CNewMonochrome);
begin
GetPalette := @P[AppPalette];
end;
procedure TTVDemo.HandleEvent(var Event: TEvent);
procedure ChangeDir;
var
D: PChDirDialog;
begin
D := New(PChDirDialog, Init(cdNormal + cdHelpButton, 101));
D^.HelpCtx := hcFCChDirDBox;
if ValidView(D) <> nil then
begin
DeskTop^.ExecView(D);
Dispose(D, Done);
end;
end;
procedure Tile;
var
R: TRect;
begin
Desktop^.GetExtent(R);
Desktop^.Tile(R);
end;
procedure Cascade;
var
R: TRect;
begin
Desktop^.GetExtent(R);
Desktop^.Cascade(R);
end;
procedure Puzzle;
var
P: PPuzzleWindow;
begin
P := New(PPuzzleWindow, Init);
P^.HelpCtx := hcPuzzle;
Desktop^.Insert(ValidView(P));
end;
procedure Calendar;
var
P: PCalendarWindow;
begin
P := New(PCalendarWindow, Init);
P^.HelpCtx := hcCalendar;
Desktop^.Insert(ValidView(P));
end;
procedure About;
var
D: PDialog;
Control: PView;
R: TRect;
begin
R.Assign(0, 0, 40, 11);
D := New(PDialog, Init(R, 'About'));
with D^ do
begin
Options := Options or ofCentered;
R.Grow(-1, -1);
Dec(R.B.Y, 3);
Insert(New(PStaticText, Init(R,
#13 +
^C'Turbo Vision Demo'#13 +
#13 +
^C'Copyright (c) 1990'#13 +
#13 +
^C'Borland International')));
R.Assign(15, 8, 25, 10);
Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
end;
if ValidView(D) <> nil then
begin
Desktop^.ExecView(D);
Dispose(D, Done);
end;
end;
procedure AsciiTab;
var
P: PAsciiChart;
begin
P := New(PAsciiChart, Init);
P^.HelpCtx := hcAsciiTable;
Desktop^.Insert(ValidView(P));
end;
procedure OpenStyx;
var
P: PStyxDemo;
begin
P := New(PStyxDemo, Init);
P^.HelpCtx := hcNoContext;
Desktop^.Insert(ValidView(P));
end;
procedure Calculator;
var
P: PCalculator;
begin
P := New(PCalculator, Init);
P^.HelpCtx := hcCalculator;
if ValidView(P) <> nil then
Desktop^.Insert(P);
end;
procedure Colors;
var
D: PColorDialog;
begin
D := New(PColorDialog, Init('',
ColorGroup('Desktop',
ColorItem('Color', 32, nil),
ColorGroup('Menus',
ColorItem('Normal', 2,
ColorItem('Disabled', 3,
ColorItem('Shortcut', 4,
ColorItem('Selected', 5,
ColorItem('Selected disabled', 6,
ColorItem('Shortcut selected', 7, nil)))))),
ColorGroup('Dialogs/Calc',
ColorItem('Frame/background', 33,
ColorItem('Frame icons', 34,
ColorItem('Scroll bar page', 35,
ColorItem('Scroll bar icons', 36,
ColorItem('Static text', 37,
ColorItem('Label normal', 38,
ColorItem('Label selected', 39,
ColorItem('Label shortcut', 40,
ColorItem('Button normal', 41,
ColorItem('Button default', 42,
ColorItem('Button selected', 43,
ColorItem('Button disabled', 44,
ColorItem('Button shortcut',